From: Camm Maguire Date: Sun, 21 Sep 2025 18:06:45 +0000 (-0400) Subject: X-Git-Tag: archive/raspbian/2.7.1-8+rpi1^2~2 X-Git-Url: https://dgit.raspbian.org/%22http://www.example.com/cgi/%22/%22http:/www.example.com/cgi/%22?a=commitdiff_plain;h=7abfd0d030fa666871e830831e889b4d9e4ffa57;p=gcl27.git Bug-Debian: https://bugs.debian.org/1106482 TODO: Put a short summary on the line above and replace this paragraph with a longer explanation of this change. Complete the meta-information with other relevant fields (see below for details). To make it easier, the information below has been extracted from the changelog. Adjust it or drop it. gcl27 (2.7.1-7) unstable; urgency=medium * Version_2_7_2pre6 * Bug fix: "[INTL:nl] Dutch debconf templates translation", thanks to Frans Spiesschaert (Closes: #1106482). Gbp-Pq: Name Version_2_7_2pre6 --- diff --git a/Makefile.am b/Makefile.am index 53d7d76..583d0ce 100644 --- a/Makefile.am +++ b/Makefile.am @@ -270,7 +270,7 @@ unixport/gcl_cmpnopt_pre_gcl.lsp: # FIXME necessary? touch $@ unixport/gcl_cmpnopt_%.lsp: unixport/lib%.a | unixport/% echo "(mapc (quote load) (directory \"$*/*.hsh\"))" \ - "(compiler::dump-inl-hash \"$@\")" | $| + "(compiler::dump-inl-hash \"$@\" t)" | $| $(addprefix unixport/lib,$(addsuffix .a,pre_gcl $(MY_DIRS))): \ unixport/lib%.a: lib/libbase_gcl.a $(LIBGPROF) unixport/sys_%.o @@ -302,7 +302,7 @@ unixport/lib%.a: | xbin/ar_merge %/recompile: | unixport/% $| -batch \ -eval "(let ((si::*do-recomp-output-dir* \"$(@D)\")) (si::do-recomp t))" \ - -eval "(compiler::dump-inl-hash \"$(@D)/all.hsh\")" + -eval "(compiler::dump-inl-hash \"$(@D)/all.hsh\" t)" touch $@ unixport/sys_%.o: unixport/sys_init.c @@ -418,7 +418,7 @@ mod_gcl/%.o: mod_gcl0/%.o | unixport/mod_gcl rm -rf $*/*.o echo "(mapc (quote load) (list $(patsubst %,\"%\",$^)))" \ "(pcl::compile-pcl)" \ - "(compiler::dump-inl-hash \"$@\")" | $| + "(compiler::dump-inl-hash \"$@\" t)" | $| %/all.hsh: %/p1.lisp %/all.hs1 | unixport/pcl_gcl echo "pcl conflicts:" diff --git a/Makefile.in b/Makefile.in index 41a7208..b218211 100644 --- a/Makefile.in +++ b/Makefile.in @@ -4701,7 +4701,7 @@ unixport/gcl_cmpnopt_pre_gcl.lsp: # FIXME necessary? touch $@ unixport/gcl_cmpnopt_%.lsp: unixport/lib%.a | unixport/% echo "(mapc (quote load) (directory \"$*/*.hsh\"))" \ - "(compiler::dump-inl-hash \"$@\")" | $| + "(compiler::dump-inl-hash \"$@\" t)" | $| $(addprefix unixport/lib,$(addsuffix .a,pre_gcl $(MY_DIRS))): \ unixport/lib%.a: lib/libbase_gcl.a $(LIBGPROF) unixport/sys_%.o @@ -4728,7 +4728,7 @@ unixport/lib%.a: | xbin/ar_merge %/recompile: | unixport/% $| -batch \ -eval "(let ((si::*do-recomp-output-dir* \"$(@D)\")) (si::do-recomp t))" \ - -eval "(compiler::dump-inl-hash \"$(@D)/all.hsh\")" + -eval "(compiler::dump-inl-hash \"$(@D)/all.hsh\" t)" touch $@ unixport/sys_%.o: unixport/sys_init.c @@ -4843,7 +4843,7 @@ mod_gcl/%.o: mod_gcl0/%.o | unixport/mod_gcl rm -rf $*/*.o echo "(mapc (quote load) (list $(patsubst %,\"%\",$^)))" \ "(pcl::compile-pcl)" \ - "(compiler::dump-inl-hash \"$@\")" | $| + "(compiler::dump-inl-hash \"$@\" t)" | $| %/all.hsh: %/p1.lisp %/all.hs1 | unixport/pcl_gcl echo "pcl conflicts:" diff --git a/cmpnew/gcl_cmpeval.lsp b/cmpnew/gcl_cmpeval.lsp index 16898b3..12dd030 100644 --- a/cmpnew/gcl_cmpeval.lsp +++ b/cmpnew/gcl_cmpeval.lsp @@ -648,6 +648,7 @@ (list (this-safety-level) (mapcar (lambda (x) (assert (eq (car x) 'ub)) (third x)) (when lf (fifth form))) (cons (when lf (third form)) (info-type (cadr form))) + (ninth form) (if lf (remove-comment (fourth form)) ""))) (defun cl-to-fn (cl) @@ -672,33 +673,77 @@ (when (eql (length x) (length cy)) (every 'type<= x cy)))))))) +(defun skip-inl (fm tps tr) + (or (member-if 'atomic-tp tps) + (atomic-tp (info-type (cadr fm))) + (exit-to-fmla-p) + (member nil tr) + (set-difference + (let ((i -1)) (mapcan (lambda (x &aux (y (incf i))) (unless (atomic-tp x) (list y))) tps)) + tr))) + +(defun ?update-fm-propagator (fm cl tr tps) + (when (symbolp (car cl)) + (when (get (car cl) 'type-propagator);?more + (when (eq (car fm) 'lit) + (when (member-if 'integerp tr) ;otherwise no point + (push (list (car cl) tr tps) (ninth fm))))))) + +(defun merge-inl (cl inl pl &aux (tps (pop inl))(tr (pop inl))) + (let ((z (member-if (lambda (x) (can-coalesce x tr inl tps)) (car pl)))) + (cond (z (coalesce-inl cl (car z) tps (cdr (third inl))) + (setf (cdr z) (remove-if (lambda (x) (can-coalesce x tr inl tps)) (cdr z)))) + (pl (let ((x (list* tps tr inl))) + (keyed-cmpnote (list (car cl) 'inl-hash 'inl-hash-add) + "Adding inl-hash ~s: ~s" (car cl) x) + (push x (car pl))))))) + +(defun merge-inls (s inls &aux (cl (list s))(pl (get-inl-list cl t))) + (mapc (lambda (x) (merge-inl cl x pl)) inls)) + (defun ?add-inl (cl fms fm) - (unless (or (member-if 'atomic-tp fms :key (lambda (x) (info-type (caddr x)))) - (atomic-tp (info-type (cadr fm))) (exit-to-fmla-p)); (inls-match cl fms) - (let* ((tps (mapcar (lambda (x) (info-type (caddr x))) fms)) - (tr (mapcar (lambda (x &aux (v (car (last x)))) - (when (and (consp v) (eq (car v) 'var)) - (position (cddr v) fms :key 'cdddr :test 'equalp)));FIXME - (if (eq (car fm) 'var) (list (list fm)) (fifth fm)))) - (nat (let ((i -1)) (mapcan (lambda (x &aux (y (incf i))) (unless (atomic-tp x) (list y))) tps)))) - (unless (or (member nil tr) (set-difference nat tr)) - (let* ((pl (get-inl-list cl t)) - (inl (lit-inl2 fm)) - (z (member-if (lambda (x) (can-coalesce x tr inl tps)) (car pl)))) - (cond (z (coalesce-inl cl (car z) tps (cdr (third inl))) - (setf (cdr z) (remove-if (lambda (x) (can-coalesce x tr inl tps)) (cdr z)))) - (pl - (let ((x (list* tps tr inl))) - (keyed-cmpnote (list (car cl) 'inl-hash 'inl-hash-add) - "Adding inl-hash ~s: ~s" (car cl) x) - (push x (car pl)))))))))) + (let* ((tps (mapcar (lambda (x) (info-type (caddr x))) fms)) + (tr (mapcar (lambda (x &aux (v (car (last x)))) + (when (and (consp v) (eq (car v) 'var)) + (position (cddr v) fms :key 'cdddr :test 'equalp)));FIXME + (if (eq (car fm) 'var) (list (list fm)) (fifth fm))))) + (?update-fm-propagator fm cl tr tps) + (unless (skip-inl fm tps tr) + (merge-inl cl (list* tps tr (lit-inl2 fm)) (get-inl-list cl t))))) (defun prepend-comment (form s) (if *annotate* (si::string-concatenate "/* " (prin1-to-string form) " */" (remove-comment s)) s)) -(defun apply-inl (cl fms &aux (inl (inls-match cl fms))) +(defvar *apply-inl-hash* t) + +(defun update-info-type-from-inl (i inl fms &aux (tps (mapcar (lambda (x) (info-type (caddr x))) fms))) + (setf (info-type i) + (reduce 'type-and + (cons (cdr (fifth inl)) + (mapcar (lambda (x) + (or + (result-type-from-args + (pop x) + (let ((i -1)) + (mapcar (lambda (tp &aux (p (position (incf i) (car x)))) + (if p (nth (nth p (second inl)) tps) tp)) + (cadr x)))) + t)) + (sixth inl))) + :initial-value (info-type i)))) + +(defun merge-fm-propagator (x fms inl) + (let* ((tr (mapcar (lambda (x &aux (v (car (last x)))) + (when (and (consp v) (eq (car v) 'var)) + (position (cddr v) fms :key 'cdddr :test 'equalp)));FIXME + (fifth x)))) + (mapc (lambda (y) (?update-fm-propagator x y tr (caddr y))) + (sixth inl)))) + + +(defun apply-inl (cl fms &aux (inl (when *apply-inl-hash* (inls-match cl fms)))) (when inl (let* ((c1fms (mapcar (lambda (x) (cdr (nth x fms))) (second inl)))) (unless (member-if-not (lambda (x) @@ -706,35 +751,56 @@ (var (eq (var-kind (caaddr x)) 'lexical)) ((lit location) t))) c1fms) - (cond ((zerop (length (car (last inl)))) - (let* ((x (car c1fms))(h (pop x)) - (i (copy-info (pop x)))) - (setf (info-type i) (type-and (cdr (fifth inl)) (info-type i))) - (keyed-cmpnote (list (car cl) 'inl-hash 'inl-hash-apply) - "Applying var inl-hash ~s" (car cl)) - (list* h i x))) - ((let ((x (c1lit (list (car (fifth inl)) (prepend-comment (cons 'applied cl) (car (last inl)))) (mapcar 'list (fourth inl) c1fms)))) - (setf (info-type (cadr x)) (type-and (cdr (fifth inl)) (info-type (cadr x)))) - (keyed-cmpnote (list (car cl) 'inl-hash 'inl-hash-apply) - "Applying inl-hash ~s: ~s: ~s" (car cl) (fourth x)) - x))))))) - -(defun dump-inl-hash (f) + (let* ((z (zerop (length (car (last inl))))) + (x (if z + (list* (caar c1fms) (copy-info (cadar c1fms)) (cddar c1fms)) + (c1lit (list (car (fifth inl)) (prepend-comment (cons 'applied cl) (car (last inl)))) + (mapcar 'list (fourth inl) c1fms))))) + (unless z (merge-fm-propagator x fms inl)) + (update-info-type-from-inl (cadr x) inl fms) + (keyed-cmpnote (list (car cl) 'inl-hash 'inl-hash-apply) + "Applying inl-hash ~s: ~s" (car cl) (unless z (fourth x))) + x))))) + + +(defun compress-inl (s &aux (i (car (gethash s *inl-hash*)))) + (when (> (length i) 1) + (let ((l (length i)) + (x (reduce (lambda (y x) + (list + (mapl (lambda (z w) (setf (car z) (type-or1 (car z) (car w)))) + (car y) (car x)) + (max (cadr y) (third x)))) + (cdr i) :initial-value (list (copy-list (caar i)) (third (car i))))) + (syms (mapcar (lambda (x) (declare (ignore x)) (gensym)) (make-list (length (caar i)))))) + (compile nil `(lambda ,syms + (declare (optimize (safety ,(cadr x))) + ,@(mapcar (lambda (x y) (list (cmp-unnorm-tp x) y)) (car x) syms)) + (,s ,@syms))) + (when (< (length (car (gethash s *inl-hash*))) l) + (format t "compress-inl ~s: ~s -> ~s~%" s l (length (car (gethash s *inl-hash*)))))))) + +(defun dump-inl-hash (f &optional compress &aux (si::*print-package* t)) + (when compress (maphash (lambda (x y) (declare (ignore y)) (compress-inl x)) *inl-hash*)) (with-open-file (s f :direction :output) (prin1 '(in-package :compiler) s) (terpri s) (maphash (lambda (x y) (prin1 - `(setf (gethash ',x *inl-hash*) - (list - (list - ,@(mapcar (lambda (z) - `(list (mapcar 'uniq-tp ',(mapcar 'export-type (pop z))) - ',(pop z) ',(pop z) ',(pop z) - (cons ',(caar z) (uniq-tp ',(cdar z))) - ,(cadr z))) - (car y))))) - s) + `(merge-inls + ',x + (list + ,@(mapcar (lambda (z) + `(list (mapcar 'uniq-tp ',(mapcar 'export-type (pop z))) + ',(pop z) ',(pop z) ',(pop z) + (cons ',(caar z) (uniq-tp ',(cdar z))) + (list ,@(mapcan + (lambda (x) + `((list ',(pop x) ',(pop x) ',(mapcar 'export-type (car x))))) + (cadr z))) + ,(caddr z))) + (car y)))) + s) (terpri s)) *inl-hash*)) nil) diff --git a/cmpnew/gcl_cmpinline.lsp b/cmpnew/gcl_cmpinline.lsp index bea3790..141fb75 100644 --- a/cmpnew/gcl_cmpinline.lsp +++ b/cmpnew/gcl_cmpinline.lsp @@ -355,7 +355,7 @@ (coerce-loc *value-to-go* type))) -(defun lit-loc (key inl args bind safety oargs stores &aux (tp (get key 'cmp-lisp-type))) +(defun lit-loc (key inl args bind safety oargs syms stores &aux (tp (get key 'cmp-lisp-type))) (declare (ignore bind safety oargs stores)) (let ((sig (list (mapcar (lambda (x) (info-type (cadr x))) args) tp))) (get-inline-loc (list (car sig) (cadr sig) (flags rfa) inl) args))) diff --git a/cmpnew/gcl_cmptag.lsp b/cmpnew/gcl_cmptag.lsp index 328e587..ba6ef9a 100644 --- a/cmpnew/gcl_cmptag.lsp +++ b/cmpnew/gcl_cmptag.lsp @@ -130,7 +130,7 @@ "Initializing ~s at label ~s:~% type from ~s to ~s,~% store from ~s to ~s" (car x) (tag-name z) (var-type (car x)) (cadr x) (var-store (car x)) (if (eq (var-store (car x)) (caddr x)) (caddr x) +opaque+)) - (do-setq-tp (car x) 'mch-set (cadr x));FIXME too prolix + (do-setq-tp (car x) '(mch-set) (cadr x));FIXME too prolix (push-vbinds (car x) (caddr x))) l)) diff --git a/cmpnew/gcl_cmptop.lsp b/cmpnew/gcl_cmptop.lsp index d8d7d45..ad44c56 100644 --- a/cmpnew/gcl_cmptop.lsp +++ b/cmpnew/gcl_cmptop.lsp @@ -865,14 +865,14 @@ (incf i lff)(copy-list ff));FIXME? ((incf i)(list x)))) nargs)) - (form (list 'lit info key inl nargs nil lev oargs (make-vs info)))) + (form (list 'lit info key inl nargs nil lev oargs nil (make-vs info)))) (when (find #\= inl) (c1side-effects nil) (setf (info-flags info) (logior (iflags side-effects) (info-flags info)))) (setf (sixth form) (new-bind form)) form)) -(defun c2lit (key inl args bind safety &rest r &aux (oargs (pop r)) (stores (car r)) (tp (get key 'cmp-lisp-type :opaque))) +(defun c2lit (key inl args bind safety &rest r &aux (oargs (pop r)) (syms (pop r)) (stores (car r)) (tp (get key 'cmp-lisp-type :opaque))) (declare (dynamic-extent r)) (let* ((*inline-blocks* 0) (*restore-avma* *restore-avma*) @@ -881,7 +881,7 @@ (*compiler-new-safety* *compiler-new-safety*) (*compiler-push-events* *compiler-push-events*)) (local-compile-decls `((safety ,safety))) - (unwind-exit (lit-loc key inl args bind safety oargs stores) nil + (unwind-exit (lit-loc key inl args bind safety oargs syms stores) nil (cons 'values (if (equal tp #t(returns-exactly)) 0 1))) (close-inline-blocks))) diff --git a/cmpnew/gcl_cmptype.lsp b/cmpnew/gcl_cmptype.lsp index a55d3bc..2190dde 100644 --- a/cmpnew/gcl_cmptype.lsp +++ b/cmpnew/gcl_cmptype.lsp @@ -731,7 +731,7 @@ (keyed-cmpnote (list (var-name v) 'type-propagation 'type 'bump-cons-tp-if) "Bumping var ~s cons type ~s -> ~s, tp ~s" (var-name v) (cmp-unnorm-tp (var-type v)) (cmp-unnorm-tp (tp-or (var-type v) tp)) (cmp-unnorm-tp tp)) - (do-setq-tp v 'bump-cons-tp-if (tp-or (var-type v) tp)))) + (do-setq-tp v '(bump-cons-tp-if) (tp-or (var-type v) tp)))) (let ((s (var-store v))) (when (listp s);FIXME (dolist (b s) diff --git a/git.tag b/git.tag index 570c038..1053920 100644 --- a/git.tag +++ b/git.tag @@ -1,2 +1,2 @@ -"Version_2_7_2ore5" +"Version_2_7_2pre6" diff --git a/info/c-interface.texi b/info/c-interface.texi index 59fe506..64e27a8 100755 --- a/info/c-interface.texi +++ b/info/c-interface.texi @@ -50,7 +50,7 @@ Unsigned versions available are: Complex float and complex double types can be access via: - :fcomplex :dcomples + :fcomplex :dcomplex Pointers to types available are diff --git a/o/assignment.c b/o/assignment.c index 8bd1d6a..34ea442 100644 --- a/o/assignment.c +++ b/o/assignment.c @@ -184,7 +184,7 @@ DEFUN("FSET",object,fSfset,SI,2,2,NONE,OO,OO,OO,OO,(object sym,object function), sym->s.s_gfdef = function; sym->s.s_mflag = TRUE; } else { - sym->s.s_gfdef = function; + sym->s.s_gfdef = function; /*FIXME*/ sym->s.s_mflag = FALSE; } diff --git a/o/num_arith.c b/o/num_arith.c index a31743c..c6ab615 100644 --- a/o/num_arith.c +++ b/o/num_arith.c @@ -1001,25 +1001,25 @@ number_divide(object x, object y) case t_complex: COMPLEX: + + x = number_to_complex(x); + y = number_to_complex(y); + { - object z1, z2, z3; - x = number_to_complex(x); - y = number_to_complex(y); - z1 = number_times(y->cmp.cmp_real, y->cmp.cmp_real); - z2 = number_times(y->cmp.cmp_imag, y->cmp.cmp_imag); - z3 = number_plus(z1, z2); - /* if (number_zerop(z3 = number_plus(z1, z2))) DIVISION_BY_ZERO(sLD,list(2,x,y)); */ - z1 = number_times(x->cmp.cmp_real, y->cmp.cmp_real); - z2 = number_times(x->cmp.cmp_imag, y->cmp.cmp_imag); - z1 = number_plus(z1, z2); - z = number_times(x->cmp.cmp_imag, y->cmp.cmp_real); - z2 = number_times(x->cmp.cmp_real, y->cmp.cmp_imag); - z2 = number_minus(z, z2); - z1 = number_divide(z1, z3); - z2 = number_divide(z2, z3); - z = make_complex(z1, z2); - return(z); + object yl=y->cmp.cmp_real,ys=y->cmp.cmp_imag,xl=x->cmp.cmp_real,xs=x->cmp.cmp_imag,r,dn,w; + int s; + + if ((s=(number_compare(number_abs(y->cmp.cmp_real),number_abs(y->cmp.cmp_imag))<0))) { + w=ys;ys=yl;yl=w;w=xs;xs=xl;xl=w; + } + + r=number_divide(ys,yl); + dn=number_plus(yl,number_times(r,ys)); + w=number_times(xl,r); + + return make_complex(number_divide(number_plus(xl,number_times(xs,r)),dn), + number_divide(s ? number_minus(w,xs) : number_minus(xs,w),dn)); } default: diff --git a/xgcl-2/gcl_editors.lsp b/xgcl-2/gcl_editors.lsp index 4040616..c9f1cd8 100644 --- a/xgcl-2/gcl_editors.lsp +++ b/xgcl-2/gcl_editors.lsp @@ -131,7 +131,7 @@ (draw-line-xy w (offsetx + 12) (offsety + 35) (offsetx + 12) (offsety + 48 + hdel * ((val - nmin) / ndel)) 7) - (editors-update-in-box val w offsetx offsety 40 20)))) + (editors-update-in-box val w offsetx offsety 40 20))) ; 20 Nov 91; 03 Dec 91; 15 Oct 93; 02 Dec 93; 08 Jan 04